Newer
Older
ExcelToAutoCAD / excel to autocad.LSP
(defun c:to>excel ( / lst>excel origlist blref-to-data selSetToSortedObjList ssget* lst head data)
  (defun ssget* (fltr / ss)
    (if (not (setq ss (ssget "_I" fltr)))
      (setq ss (vl-catch-all-apply 'ssget (list fltr)))
      )
    (cond
      ((= 'VL-CATCH-ALL-APPLY-ERROR (type ss)) (VL-CATCH-ALL-ERROR-MESSAGE ss))
      ((= 'PICKSET (type ss)) ss)
      (T nil)
      )
    );defun

  (defun selSetToSortedObjList (ss / lst rule)	;(setq ss (ssget))
    (setq lst (reverse (ssnamex ss)))
    (while (listp (cadar lst)) (setq lst (cdr lst)))
    (setq lst (mapcar '(lambda (x) (cadr x)) lst))
    (initget 1 "x -x y -y content")
    (setq rule (vl-catch-all-apply 'getkword '("\n Правило сортировки : [x/-x/y/-y/content] <x> \n")))
    (cond
      ((= 'VL-CATCH-ALL-APPLY-ERROR (type rule)) (setq rule nil))
      
      ((= rule "x")(setq rule '(< (cadr (assoc 10 (entget a))) (cadr (assoc 10 (entget b))))))
      ((= rule "y")(setq rule '(< (caddr (assoc 10 (entget a))) (caddr (assoc 10 (entget b))))))
      ((= rule "-x")(setq rule '(> (cadr (assoc 10 (entget a))) (cadr (assoc 10 (entget b))))))
      ((= rule "-y")(setq rule '(> (caddr (assoc 10 (entget a))) (caddr (assoc 10 (entget b))))))
      ((= rule "content")(setq rule '(< (cdr (assoc 1 (entget a))) (cdr (assoc 1 (entget b))))))
      )
    (setq lst (vl-sort lst '(lambda (a b) (eval rule))))
    (mapcar 'vlax-ename->vla-object lst)
    );defun

  (defun blref-to-data (obj / getbattswcmatch)
    (defun getbattswcmatch ( bobj str / al)
      (if
	(and
	  (vlax-method-applicable-p bobj "getattributes")
	  (setq al (vlax-variant-value (vla-getattributes bobj)))
	  (<= 0 (vlax-safearray-get-u-bound al 1))
	  (setq al (vlax-safearray->list al))
	  )
	(vl-remove-if-not '(lambda (x) (wcmatch (vla-get-tagstring x) (strcat str "," (strcase str)))) al)
	)
      );defun
    (if (= "AcDbBlockReference" (vla-get-ObjectName obj))
      (cons
	(list (strcat "[BN]=" (vla-get-EffectiveName obj)) (vla-get-Handle obj))
	(mapcar
	  '(lambda (att / destatt str)
	     (list (vla-get-TagString att) (vla-get-TextString att))
	     )
	  (getbattswcmatch obj "*")
	  )
	)
      )
    );defun
  (defun origlist (lst / ans)
    (mapcar '(lambda (x) (if (null (member x ans)) (setq ans (cons x ans)))) lst)
    (reverse ans)
    );defun

  (defun lst>excel (lst / #excel wkbs wb ash range nl)
    (setq #excel (vlax-get-or-create-object "Excel.Application"))
    (vlax-put-property #excel "Visible" :vlax-true)
    (setq wkbs (vlax-get-property #excel "Workbooks"))
    (setq wb (vlax-invoke-method wkbs "Add" 1))
    (setq ash (vlax-get-property wb "ActiveSheet"))
    (setq nl 0)
    (foreach line lst
      (setq range (vlax-get-property ash "Range" (strcat "A" (itoa (setq nl (1+ nl))))))
      (foreach str line
	(vlax-put-property range "NUMBERFORMAT" "@")
	(vlax-put-property range "Value2" str)
	(setq range (vlax-get-property range "Next"))
	))
    (mapcar (function (lambda (x) (if (not (vlax-object-released-p x)) (vlax-release-object x)))) (list range ash wb wkbs #excel))
    (setq range nil ash nil wb nil wkbs nil #excel nil)
    (prin1)
    );defun
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  (if
    (and (setq lst (ssget* '((0 . "INSERT")))) (= 'PICKSET (type lst)))
    (progn
      (princ "\n\nPlease do not change a handle column\n")
      (setq lst (selSetToSortedObjList lst))
      ;(mapcar '(lambda (x) (vla-get-textstring (getbatt x "POZ"))) lst)
      (setq data (mapcar 'blref-to-data lst))
      (setq head (origlist (mapcar 'car (apply 'append data))))      
      (setq res (mapcar '(lambda (bobj) (mapcar '(lambda (par / a) (if (setq a (assoc par bobj)) (cadr a)"")) head)) data))
      (lst>excel (cons head res))
      )
    )
  );defun










(defun c:excel>into ( / sepstr getbatt excel>lst db|formatdata lst head data reprt htn htns bname)
  (defun db|formatdata (lines / rtos* ans)
    (defun rtos* (num / str)
      (if (null num) "" (VL-LIST->STRING (subst 44 46 (VL-STRING->LIST (rtos num)))))
      );defun
    (setq ans (mapcar
		'(lambda (line)
		   (mapcar
		     '(lambda (x)
			(cond
			  ((or (= (type x) 'INT) (= (type x) 'REAL)) (rtos* x))
			  ((= "м?/ч" x) "м\U+00B3/ч")
			  ;;   kappa \U+00E6	63
			  ((= "#" x) "")
			  ((null x) "")
			  (T x)
			  )
			)
		     line
		     )
		   )
		lines
		))
    (setq ans (vl-remove-if '(lambda (x) (apply '= (cons nil x))) ans))
    (setq ans (vl-remove-if '(lambda (x) (apply '= (cons "" x))) ans))
    );defun
  (defun excel>lst ( / cont>list xls|getDataFramed xls|getDataNotFramed #excel #selection isSelectionFramed result)
    (defun cont>list (objc / lst) (vlax-for o objc (setq lst (append lst (list o)))) lst)
    (defun xls|getDataFramed (selection / sa)
    (setq sa (vl-catch-all-apply 'vlax-get-property (list Selection "Value2")))
    (if (= (type sa) 'variant) (setq sa (vlax-variant-value sa)) (setq sa nil))
    (cond ((= 'STR (type sa)) sa) ((= 'safearray (type sa)) (mapcar '(lambda (line) (subst "" nil (mapcar 'vlax-variant-value line))) (vlax-safearray->list sa))) (T nil))
    )
  (defun xls|getDataNotFramed (#excel / #actsht #usedRange #usedRows usedRowsQuantity #areas return) ;#selection)
    ;(setq #selection (vlax-get-Property #excel "Selection"))
    (setq #actsht (vlax-get-Property #excel "ActiveSheet"))
    (setq #usedRange (vlax-get-Property #actsht "UsedRange"))
    (setq #usedRows (vlax-get-Property #usedRange "Rows"))
    (setq usedRowsQuantity (vlax-get-Property #usedRows "Count"))
    (setq #areas (vlax-get-Property #selection "Areas"))
    (setq return
	   (mapcar
	     '(lambda (area)
		(if (> (vlax-get-property area "Count")  usedRowsQuantity)
		  (progn
		    (mapcar
		      '(lambda (col / cells i column)
			 (setq cells (vlax-get-property col "Cells"))
			 (setq i 0) (setq column '())
			 (while (< (setq i (1+ i)) (1+ usedRowsQuantity)) (setq column (cons (vlax-variant-value (vlax-get-property (vlax-variant-value (vlax-get-property cells "Item" i)) "Value2")) column)))
			 (reverse column)
			 )
		      (cont>list (vlax-get-property area "Columns"))
		      )
		    )
		  )
		)
	     (vl-remove-if '(lambda (area) (< (vlax-get-property area "Count") 2)) (cont>list #areas))
	     ))
    (setq return (apply 'append return))
    (vlax-release-object #areas)
    ;(vlax-release-object #selection)
    (vlax-release-object #usedRows)
    (vlax-release-object #usedRange)
    (vlax-release-object #actsht)
    (apply 'mapcar (cons 'list return))
    )
  (setq #excel (vlax-get-object "Excel.Application"))
  (setq #selection (vlax-get-Property #excel "Selection"))
  (if (setq isSelectionFramed (< (vlax-get-Property #selection "Count") (expt 2 20)))
    (setq result (xls|getDataFramed #selection))
    (setq result (xls|getDataNotFramed #excel))
    )
  (vlax-release-object #selection)
  (vlax-release-object #excel)
  result
  );defun
  (defun getbatt (bobj tag / al sc )
    (if
      (and
	(vlax-method-applicable-p bobj "getattributes")
	(setq al (vlax-variant-value (vla-getattributes bobj)))
	(<= 0 (vlax-safearray-get-u-bound al 1))
	(setq al (vlax-safearray->list al))
	)
      (progn
	(setq al (vl-remove-if-not '(lambda (x) (member (vla-get-tagstring x) (list tag (strcase tag)))) al))
	(cond
	  ((= 1 (length al)) (car al))
	  (T nil)
	  )
	)
      )
    );defun
  (defun sepstr (strline delimiter / strhead strtail poz)
    (if (setq poz (vl-string-search delimiter strline))
      (progn (setq strhead (substr strline 1 poz) strtail (substr strline (+ poz 1 (strlen delimiter))))
	(append (list strhead) (sepstr strtail delimiter)))
      (list strline)
      );if
    );defun
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setq #excel>into:reprt nil)
  (if (and
	(setq lst (db|formatdata (excel>lst)))
	(setq data (cdr lst) head (car lst))
	(setq htns (vl-remove-if-not '(lambda (x) (= "[BN]" (substr x 1 4))) head))
	)
    (progn
      (mapcar
	'(lambda (htn)
      (setq bname (cadr (sepstr htn "=")))
      (mapcar
	'(lambda (line / h bobj)	;(setq line (nth 0 data))
	   (setq h (nth (vl-position htn head) line))
	   (if (/= "" h)
	     (progn
	       (setq bobj (vl-catch-all-apply 'vla-HandleToObject (list #actdoc h)))
	       (cond
	     ((= (type bobj) 'VLA-OBJECT)
	      (mapcar
		'(lambda (tag / att aval val)	;(setq tag "PROP1")
		   (if (setq att (getbatt bobj tag))
		     (progn
		       (setq aval (vla-get-textstring att))
		       (setq val (nth (vl-position tag head) line))
		       (vla-put-TextString att val)
		       (if (/= aval val) (setq #excel>into:reprt (cons (list h (strcat "TAG '" tag "' changed from '" aval "' to '" val "'")) #excel>into:reprt)))
		       )
		     )
		   )
		(vl-remove htn head)
		)
	      )
	     ((= (type bobj) 'VL-CATCH-ALL-APPLY-ERROR) (setq #excel>into:reprt (cons (list h (VL-CATCH-ALL-ERROR-MESSAGE bobj)) #excel>into:reprt)))
	     );cond
	       )
	     )
	   )
	data
	)
	   )
	htns
	)
      )
    (alert "выдели handle'ы блиа")
    )
  (princ "\n\n inspect #excel>into:reprt to see report")
  (princ)
  );defun

(vl-load-com) (setq #cad (vlax-get-acad-object) #actdoc (vla-get-activedocument #cad) #modspace (vla-get-modelspace #actdoc))
(princ (strcat "\n\n"
	 "	Type in the command line:\n"
	 "	to>excel - (on selected block inserts / or select them later) to export data to excel sheet\n"
	 "	excel>into - to import data back to the blocks from excel (selecting beforehand a range you want to import including table-head)\n"
	 ))